home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / ftp_get.tcl.z / ftp_get.tcl
Text File  |  2002-07-08  |  6KB  |  241 lines
  1. # ftp_get.tcl
  2. #
  3. # Author: Ovidiu Predescu <ovidiu@aracnet.com>
  4. #
  5. # Retrive an a file via FTP using passive data transfer (see RCF 959)
  6.  
  7. set ftp(cmdSock) -1
  8. set ftp(dataSock) -1
  9. set ftp(host) ""
  10. set ftp(directory) ""
  11. set ftp(filename) ""
  12.  
  13. proc FtpConnect {server port} {
  14.     HttpLog ftp $server on $port
  15.     set sock [socket $server $port]
  16.     fconfigure $sock -blocking false
  17.     return $sock
  18. }
  19.  
  20. proc FtpSetConnectionInfo { url } {
  21.     upvar #0 $url data
  22.     global ftp
  23.  
  24.     # Check if the URL is correct. Also separate the host, directory
  25.     # and filename
  26.     if {![regexp "\[fF\]\[tT\]\[pP\]://(\[^/\]+)(.*)/(\[^/\]*)" $url x \
  27.           ftp(host) ftp(directory) ftp(filename)]} {
  28.     return 0
  29.     }
  30.  
  31.     # Create the data file
  32.     set data(file) [Cache_NewFile $data(url)]
  33.     if {[catch {open $data(file) w 0600} data(fd)]} {
  34.     Exmh_Status "Cannot write to HTML cache directory"
  35.     Http_kill $data(url)
  36.     } else {
  37.     HttpLog "using file $data(file)"
  38.     fconfigure $data(fd) -translation lf
  39.     }
  40.  
  41.     return 1
  42. }
  43.  
  44. proc Ftp_event {url} {
  45.     global Http env ftp
  46.     upvar #0 $url data
  47.  
  48.     if {![info exists data] || ![info exists data(socket)]} {
  49.     return
  50.     }
  51.     if ![info exists data(count)] {
  52.     set data(count) 0
  53.     }
  54.  
  55.     if [catch {
  56.     switch $data(what) {
  57.         connected {
  58.         # Get the server's greeting
  59.         ftp_reply_expect 220
  60.         # Send the user name
  61.         ftp_send "USER anonymous"
  62.         set data(what) login
  63.         Exmh_Status "login into $ftp(host)..."
  64.         HttpLog "login into $ftp(host)..."
  65.         }
  66.  
  67.         login {
  68.         # Get the user name response reply
  69.         ftp_reply_expect 230 331
  70.         # Send the password
  71.         ftp_send "PASS $env(USER)@"
  72.         set data(what) password
  73.         }
  74.  
  75.         password {
  76.         # Get the password response reply
  77.         ftp_reply_expect 230
  78.         ftp_send "CWD $ftp(directory)"
  79.         set data(what) changedir
  80.         Exmh_Status "changing directory to $ftp(directory)..."
  81.         HttpLog "changing directory to $ftp(directory)..."
  82.         }
  83.  
  84.         changedir {
  85.         # Get the change directory reply
  86.         ftp_reply_expect 250
  87.         # Set the type to binary
  88.         ftp_send "TYPE I"
  89.         set data(what) settype
  90.         }
  91.  
  92.         settype {
  93.         # Get the type set reply
  94.         ftp_reply_expect 200
  95.         # Create a pasive connection to the server
  96.         ftp_send "PASV"
  97.         set data(what) dataconnection
  98.         }
  99.  
  100.         dataconnection {
  101.         # Get the data connection information
  102.         ftp_get response
  103.         if {![regexp "^227" $response]} {
  104.             error "the FTP server does not support passive connections!"
  105.         }
  106.         if {![regexp "^227(\[^0123456789\]*)(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+).*$" $response x y h1 h2 h3 h4 p1 p2]} {
  107.             error "cannot get the address of the server socket data"
  108.         } else {
  109.             set host $h1.$h2.$h3.$h4
  110.             set port [format "%u" 0x[format "%x%x" ${p1} ${p2}]]
  111.             if [catch {set ftp(dataSock) [socket $host $port]} err] {
  112.             error "cannot open data socket to $host, port $port! ($err)"
  113.             }
  114.             fconfigure $ftp(dataSock) -blocking false
  115.         }
  116.         # Send the retrieve command
  117.         ftp_send "RETR $ftp(filename)"
  118.         Exmh_Status "opening the data channel for $ftp(filename)..."
  119.         HttpLog "opening the data channel for $ftp(filename)..."
  120.         set data(what) retrievecmd
  121.         }
  122.  
  123.         retrievecmd {
  124.         # Get the response from the retrieve request and
  125.         # analyze it to get information about the file's size
  126.         ftp_get response
  127.         if {![regexp "^150" $response]} {
  128.             error "$response"
  129.         }
  130.         if {![regexp "^150.*\\((\[0-9\]+).*" $response x data(length)]} {
  131.             set data(length) -1
  132.         }
  133.         set data(what) dataget
  134.         }
  135.  
  136.         dataget {
  137.         # Get the data from the data socket
  138.         if [catch {copychannel $ftp(dataSock) $data(fd) $Http(hunk)} more] {
  139.             catch {eval $data(progress) error $more 0}
  140.             error "Read error on $url\n$more"
  141.         }
  142.         if {$more >= 0} {
  143.             incr data(count) $more
  144.             catch {eval $data(progress) file $data(count) $data(length)}
  145.         }
  146.         if {$data(length) > 0} {
  147.             set percent [format "%3.1f" [expr $data(count) * 100 / $data(length)]]
  148.             Exmh_Status "$url...$percent%"
  149.             HttpLog "$url...$percent%"
  150.         } else {
  151.             set kbytes [format "%4.1" [expr $data(count) / 1024]]
  152.             Exmh_Status "$url...$kbytes kb"
  153.             HttpLog "$url...$kbytes kb"
  154.         }
  155.         if [eof $ftp(dataSock)] {
  156.             set data(what) closeconnection
  157.         }
  158.         }
  159.  
  160.         closeconnection {
  161.         Exmh_Status "$url...done"
  162.         HttpLog "$url...done"
  163.         catch {close $ftp(dataSock)}
  164.         set ftp(dataSock) -1
  165.         catch {close $ftp(cmdSock)}
  166.         set ftp(cmdSock) -1
  167.         Http_depend $url
  168.         catch {close $data(fd)}
  169.         unset data(fd)
  170.         Cache_SetFile $url $data(file)
  171.         catch {eval $data(progress) done $data(count) $data(length)}
  172.         foreach cmd $data(command) {
  173.             HttpLog $cmd
  174.             catch $cmd
  175.         }
  176.         set data(command) ""
  177.         after idle Http_poke
  178.         }
  179.  
  180.     }
  181.     } err] {
  182.     if {$err != "again"} {
  183.         # An error appeared during the execution of the protocol
  184.         HttpLog $err
  185.         catch {eval [list $data(progress) error "$err" $data(length)]}
  186.         catch {close $ftp(dataSock)}
  187.         set ftp(dataSock) -1
  188.         catch {close $ftp(cmdSock)}
  189.         set ftp(cmdSock) -1
  190.         catch {close $data(fd)}
  191.         unset data(fd)
  192.         Http_kill $url
  193.         return
  194.     } else {
  195.         # Not enough data; return to the main loop and await for
  196.         # more data
  197.         return
  198.     }
  199.     }
  200. }
  201.  
  202. proc ftp_reply_expect { args } {
  203.     ftp_get response
  204.  
  205.     foreach code $args {
  206.     if {[regexp "^$code.*" $response]} {
  207.         return;
  208.     }
  209.     }
  210.     error "bad response from the ftp server: $response"
  211. }
  212.  
  213. proc ftp_get { varname } {
  214.     global ftp
  215.     upvar $varname response
  216.  
  217.     if {[gets $ftp(cmdSock) response] == -1} {
  218.     if [fblocked $ftp(cmdSock)] {
  219.         # Line was not read completly because there's not a full
  220.         # line available yet
  221.         error "again"
  222.     } else {
  223.         # End of file was encountered before reading a full line
  224.         close $ftp(cmdSock)
  225.         set ftp(cmdSock) -1
  226.         error "remote has closed the connection!"
  227.     }
  228.     }
  229.     HttpLog "ftpd: $response"
  230. }
  231.  
  232. proc ftp_send { cmd } {
  233.     global ftp
  234.  
  235.     HttpLog "--> $cmd"
  236.     if [catch {puts $ftp(cmdSock) $cmd} err] {
  237.     error "cannot send to ftp socket: $err"
  238.     }
  239.     flush $ftp(cmdSock)
  240. }
  241.